00100	C*** BEAMS, BMREAD ************
00200		SUBROUTINE BEAMS
00300		INTEGER UPDN
00400		COMMON R2,JAZ,CENTR,JBZ,RJQ(20),JQ(20) /STF/RSTFAC(8),RSTJ2
00500		1 /XRN/RN(1) /PTR/KWDS(1) /RNW/RNW /A2Z/LAA,LBB
00600		1 /RINP/R(10,85),POSNT(0/99) /RMOD/RMODE2,SET4,IBEAM,
00700		1 NOSET,STEM,STUP,NTC,PS2,RAM,JSTEM,IT,POS
00800		1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
00900		1 /LIMIT/LIMIT,ITEM,LL,IS,IX /DPY/ST(3900),RHY(100)
01000		1 /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
01100		1 /SCX/JALPHA(7),ISTAR,JAL(22),X,U,JZ,IRHY,JD,KA,KB,IZ
01200		1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
01300		1 ,JXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
01400	
01500		IF(RMODE.GE.500)RETURN
01600	C  NO BEAMS WHEN USING SUBR. 'EXTRA' *********
01700		INVT=-1
01800		LS=IS
01900	C SAVE PTR TO RN ARRAY FOR SLUR FEATURE AT 614 (AND TREM. FEATURE)
02000		JNTC=NTC
02100		J=0
02200		A=-1.
02300		DO 1125 K=1,IZ
02400		IF(R(1,K).GT.2)GO TO 1125
02500	C GET BACK RHYTH. INFO IN P9 OF NOTES  (FOR JDIF, COMPOSITE BEAMS)
02600		B=R(3,K)
02700		IF(A.EQ.B)GO TO 1125
02800	C SKIP CHORD NOTES.
02900		A=B
03000		J=J+1
03100		RHY(K)=V(J)
03200	1125	CONTINUE
03300	125	IF(REND.NE.0)GO TO 25
03400		REND=3
03500	25	DO 1500 K=1,72
03600		IF(INP(K).EQ.LBB)GO TO 22
03700	C  B=AUTOMATIC BEAMS.
03800		IF(INP(K).EQ.ISTAR)GO TO 15
03900	1500	IF(INP(K).EQ.ISEMI)GO TO 500
04000	15	INP(72)=ISTAR
04100		GO TO 500
04200	C ABOVE FOR 2ND LNE OF INPUT. IF LNS ENDS WITHOUT * OR ;, IT PUTS IN *
04300	CC22	CALL BEAMQ
04400	CC	SUBROUTINE BEAMQ
04500	CC	COMMON /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
04600	CC	1 /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
04700	CC	1 /SCX/JALPHA(7),ISTAR,JAL(22),X,U,JZ,IRHY,JD,KA,KB,IZ
04800	CC	1 /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,NFLG
04900	CC	1 ,JXX,ISEMI,IQT,VX(50),IAMP,K,KN,M
05000	22	REREAD F78F,A,RB,RC
05100	C  TYPE '2B' OR '3B' ETC. FOR AUTOMATIC BEAMS. (2=DUPLE  3=TRIPLE)
05200		IF(IREAD.NE.-1)GO TO 2222
05300		A=RB
05400		RB=RC
05500	C  IREAD=-1 WHEN READING SOS FILES. (=-2 WITH ET FILES.)
05600	2222	A=A/2.
05700	C  '2'=1  '3'=1.5   '2B 3;'  MEANS THERE'S A 3 NOTE PICK-UP.
05800	CS	IF(STEM)STEM=0
05900	C STEM=10 OR 20 IF ALREADY SETUP IN NOTES
06000		N=0
06100		J=0
06200		INP(72)=ISTAR
06300	
06400		GR=4./88.
06500		NN=0
06600		NX=0
06700	C NX IS REST COUNTER
06800		NZ=0
06900		NL=1
07000		NJ=0
07100		NR=1
07200		JV=0
07300	C  JV IS VX COUNTER
07400		C=0
07500		B=A-.001
07600		IF(RB.EQ.0)GO TO 122
07700		J=RB
07800	C RB=NUM OF PICKUP ITEMS.*******(NTS AND RSTS - BUT NOT GRACE NTS.)*******
07900		B=-.001
08000		DO 222 K=1,J
08100	222	IF(V(K).NE.GR)B=B+ABS(V(K))
08200	C  ABOVE FOUND VALUE OF PICKUPS
08300	122	X=ABS(V(NR))
08400		IF(X.NE.GR)GO TO 2122
08500		NN=NN+1
08600		GO TO 2022
08700	2122	C=C+X
08800	C  ADD ON RHYTH VALUE -- IF NOT GRACE NOTES
08900		IF(V(NR))N=N+1
09000	C  FINDS RESTS AND GRACE NOTES (WE SKIP THEM)
09100		IF(C.GT.B)GO TO 822
09200	2022	IF(NR.EQ.IRHY)GO TO 422
09300	922	NR=NR+1
09400	C  NR=RIGHT SIDE OF BEAM, NL=LEFT
09500		GO TO 122
09600	822	IF(NR-NL-NN-N.GT.0)GO TO 322
09700	C  IGNORE IF ONLY ONE NOTE FILLS UNIT
09800	722	IF(NR.EQ.IRHY)GO TO 422
09900		NN=0
10000		NJ=NJ+N
10100		NZ=NJ  
10200		N=0
10300		NL=NR+1
10400	C PUSH AHEAD FOR NEXT BEAM
10500	622	B=B+A
10600	C UPDATE SPACE POINTER
10700		IF(C.GT.B)GO TO 622
10800		GO TO 922
10900	
11000	C  MAIN AUTO BEAM SECTION. 
11100	322	DO 21 K=NL,NR-1
11200	C THIS LOOP FINDS FIRST NOTE OF BEAM.
11300		X=V(K)
11400		IF(X)GO TO 21
11500		IF(X.EQ.GR)GO TO 21
11600		IF(NOTAIL(X))GO TO 21
11700	C SKIP IF NOTE VAL. DOESN'T REQUIRE A TAIL 
11800		JV=JV+2
11900	COUNTER FOR VX ARRAY (WHERE WE PUT BEAM'S NOTE NUMS.)
12000		VX(JV-1)=K-NREST(K)
12100	C FUNCT. NREST TELLS HOW MANY RESTS TO SUBTRACT
12200		GO TO 221
12300	21	CONTINUE
12400	C IF WE GET HERE, NO BEAM NOTES FOUND.
12500		GO TO 722
12600	221	DO 321 K=NR,NL,-1
12700	C THIS LOOP FINDS LAST NOTE OF BEAM.
12800		X=V(K)
12900		IF(X)GO TO 321
13000		IF(X.EQ.GR)GO TO 321
13100		IF(NOTAIL(X))GO TO 321
13200		VX(JV)=K-NREST(K)
13300	C NREST SUBTRACTS ALL INTERVENING RESTS
13400		IF(VX(JV).EQ.VX(JV-1))JV=JV-2
13500	CATCHES TRIPLET 1/8 TO TRIPLET 1/4, ETC.
13600		GO TO 722
13700	321	CONTINUE
13800	
13900	C  NEXT FOR BEAMED GRACE NOTES
14000	422	N=0
14100		J=1
14200	1122	X=V(J)
14300		IF(X)N=N+1
14400		NR=0
14500		IF(X.NE.GR)GO TO 1022
14600		NL=J
14700		DO 1222 K=J,IRHY
14800		X=V(K)
14900		IF(X.OR.X.NE.GR)GO TO 1322
15000	C  STOPS GRACE NOTE BEAM AT REST OR NON-GRACE
15100	1222	NR=K
15200	1322	IF(NR-NL.LE.0)GO TO 1022
15300		CALL BAUTO(JV,NL,NR,N)
15400	C UPDATE VX COUNTER
15500		NL=NL+1
15600		J=NR
15700	1022	J=J+1
15800		IF(J.LE.IRHY)GO TO 1122
15900	
16000	1422	IF(JV.EQ.0)RETURN
16100	C  NO BEAMS - SO GO BACK.
16200		DO 2822 K=JV+1,50
16300	C  USES ONLY 68 SLOTS IN 'V'
16400	2822	VX(K)=0
16500	CC	END
16600	 
16700		J=0
16800		GO TO 511
16900	
17000	C  *******  1ST MAIN LOOP *********
17100	500	REREAD F78F,VX
17200		J=0
17300		IF(IREAD.EQ.-1)J=1
17400	C  SKIPS LINE #S IN SOS FILES. (=-2 IS FOR ET FILES.)
17500	511	J=J+1
17600		N=VX(J)
17700		JMP=1
17800		JDIF=0
17900	505	L=0
18000		K=0
18100		C=0
18200		POS=-10.
18300		RN(8+IS)=0
18400		RN(9+IS)=0
18500		IT=0
18600		UPDN=0
18700	CS	IF(JSTEM.LT.*****0)GO TO 503
18800	CS	IF(STEM.EQ.0)GO TO 503
18900	C  UPDN=2=STEMS DOWN, (SLUR DIP UP)  =1, OPPOSITE.
19000	104	JA=J+1
19100		B=VX(JA)
19200	C THE 2ND NOTE (-=DIP DOWN ALWAYS; +100=UP ALWAYS, ORD.=AUTOMATIC)
19300		IF(B.LT.100)GO TO 512
19400		UPDN=2
19500		B=B-100
19600		IF(B.GT.100)B=100-B
19700	C  TYPE -NUM OR 200+NUM FOR DIP DOWN.
19800		VX(JA)=B
19900	512	IF(B)UPDN=1
20000		RN(9+IS)=0
20100		BRK=AMOD(VX(J),1.)*10.
20200		IF(BRK.EQ.0)GO TO 503
20300	C ADDS NUM TO BRACK. OR BEAM. ADD DESIRED .NUM TO 1ST NUM.(1.3=3)
20400		RN(9+IS)=BRK+.0001
20500		GO TO 5030
20600	503	IF(N.GT.0)GO TO 5031
20700		IT=-1
20800		CALL SLEND
20900	C  -1= SLUR INTO 1ST NOTE.
21000	C  SETS POS OF LFT SIDE (-10+9, THEN +2)
21100		GO TO 5060
21200	5031	IF(N.LE.JNTC)GO TO 5030
21300	C  JNTC=NUM OF REAL NTS+1
21400		CALL SLEND
21500	C  SLEND CHECKS ON END POINTS OF THIS STAFF
21600		GO TO 504
21700	5030	L=L+1
21800	502	K=K+1
21900		IF(R(1,K).NE.1.)GO TO 502
22000	C  IS IT A NOTE?
22100		P=R(3,K)
22200		IF(P.EQ.POS)GO TO 502
22300	C  SKIPS DBLSTPS
22400		POS=P
22500		IF(L.LT.N)GO TO 506
22600		IF(C.NE.0)GO TO 506
22700		IF(R(10,K).EQ.0)C=19.-R(5,K)
22800	C GET STEM DIR. OF 1ST NOTE ON MAIN STAFF
22900	506	IF(L.LT.N)GO TO 5030
23000	5060	IF(JMP)GO TO 504
23100	C  JMP=-1 MEANS END NOTE OF GROUP
23200		J=J+1
23300		NN=VX(J)
23400	C  IF 2ND NUM IS .LE. 1ST , THEN 2-NOTE SLUR. (-1 GOES TO 1)
23500		IF(NN.EQ.0)NN=N+1
23600		IF(NN.EQ.0)NN=1
23700		IF(NN)GO TO 5061
23800		IF(NN.LE.N)NN=N+1
23900	C  FOR USE WITH AUTO-BEAMS OR DIP UP.  2-NOTE SLUR OR BEAM UP.
24000	
24100	5061	MK=N
24200		N=NN
24300	CC	N=IABS(NN)
24400		M=K
24500		JA=3
24600		JB=4
24700		KN=K
24800		RB=0
24900		GO TO 550
25000	504	RB=2
25100		IF(NN)RB=-RB
25200	C  DIP IS SET BY PARAM 7. (STEM DIR. IS AUTOMATIC)
25300	550	RN(JA+IS)=POS
25400	CX	B=XNOTE(K)
25500		B=ZNOTE(K)
25600	C ZNOTE GETS HEIGHT AND CHECKS FOR NOTE ON OTHER STAFF/STEM DIR.
25700	
25800	513	RN(JB+IS)=B+RB
25900	C  MK=# OF 1ST NOTE, N=END NOTE NOW
26000		JMP=-JMP
26100		IF(JMP.GT.0)GO TO 1503
26200	C  GO FIND RT. SIDE OF SLUR
26300		JA=6
26400		JB=5
26500		IF(N.LE.MK)N=MK+1
26600	C  PICKS UP TYPO ERRORS
26700		GO TO 503
26800	
26900	1503	RN(2+IS)=STAFF
27000		IF(NN.GE.0)GO TO 277
27100		IF(C.GT.0)GO TO 377
27200	277	IF(C.GE.0)GO TO 35
27300		IF(NN.LE.0)GO TO 35
27400	377	NN=-NN
27500	
27600	CCCC35	RA=10.
27700	C  RA WILL=# OF TAILS,  KN=1ST NOTE, K=LAST ('MOD' FOR DOTTED NOTES.)
27800	35	RN(1+IS)=6
27900		JMAX=0
28000		IF(N-MK.EQ.1)JMAX=-1
28100		DMAX=100.
28200		UMAX=-DMAX
28300	C  FOR AUTO. BEAMS
28400	
28500		JB=0
28600		MB=0
28700	C MB=-1 =GRACE NOTES UNDER BEAMS.  
28800		IF(ABS(R(4,KN)).GE.80.)MB=-1
28900		RDIF=0
29000	C JDIF AND RDIF ARE FOR NEW COMPOSITE BEAM FEATURE 5/78
29100		JDIF=0
29200		DO 2 L=KN,K
29300		IF(R(1,L).NE.1)GO TO 2
29400		IF(JDIF.NE.0)GO TO 1212
29500		BB=RHY(L)
29600		IF(BB.LE.0)GO TO 1212
29700		IF(BB.EQ.4./88.)GO TO 1212
29800		IF(RDIF.NE.0)GO TO 2212
29900		RDIF=BB
30000	C NOW WE HAVE FIRST RHYTH. VALUE UNDER BEAM
30100		RA=AMOD(R(7,L),10.0)
30200	C  RA WILL=# OF TAILS  ON 1ST NOTE.
30300		GO TO 1212
30400	2212	IF(RDIF.EQ.BB)GO TO 1212
30500		JDIF=L
30600		KDIF=IS
30700	C FOUND A DIFF. RHYTH. UNDER BEAM
30800	CXCX1212	IF(R(10,L).NE.0)GO TO 2
30900	C SKIP NOTES ON ANOTHER STAFF.**************?????????????
31000	1212	BB=R(5,L)
31100		IF(BB.GE.10.)GO TO 12
31200		UPDN=-1
31300		NN=19-AA
31400	CHORDS WILL HAVE FIXED STEM DIRECTIONS ALWAYS
31500		GO TO 2
31600	C  SKIPS NON-NOTES AND DBLSTPS
31700	12	IF(MB)GO TO 10
31800		AA=BB
31900		RB=R(4,L)
32000		IF(ABS(RB).GE.80)GO TO 2
32100	C  SKIPS GRACE NOTES
32200		GO TO 110
32300	10	RB=ZNOTE(L)
32400	CX10	RB=XNOTE(L)
32500	110	IF(RB.GT.UMAX)UMAX=RB
32600		IF(RB.LT.DMAX)DMAX=RB
32700	C  FOR AUTO. BEAMS
32800		RB=AMOD(R(7,L),10.0)
32900	112	IF(RA.EQ.RB)GO TO 2
33000		JB=-1
33100	C   FLAG FOR MIXED NUM. OF BEAMS
33200		IF(RB.GE.RA)GO TO 2
33300		IF(RB.NE.0)RA=RB
33400	2	CONTINUE
33500	C  ABOVE FINDS SMALLEST # OF TAILS.  NEXT FOR HGTS.
33600	C  ABOVE IS POS.2
33700		IT=KN
33800		M=3
33900	203	IF(R(10,IT).EQ.0)GO TO 202
34000		IF(JSTEM.GT.IT)GO TO 202
34100	CS	IF(STEM.LE.0)GO TO 202
34200	        C=RNW
34300		IF(NN)GO TO 206
34400		IF(R(5,IT).LT.20)GO TO 202
34500		C=-C
34600		GO TO 205
34700	206	IF(R(5,IT).GE.20)GO TO 202
34800	205	IF(ABS(R(4,IT)).GE.80.)C=C*.6
34900	C FOR MINI BEAMS
35000		RN(M+IS)=RN(M+IS)+C*RSTJ2
35100	202	IF(IT.NE.KN)GO TO 201
35200		IT=K
35300		M=6
35400		GO TO 203
35500		
35600	C  FOR EXTRA BEAMS WITH CHORDS. SAVE IT IN "IT"
35700	201	IF(JSTEM.LE.IT)GO TO 577
35800	CS201	IF(STEM.GT.0)GO TO 577
35900	C  *****↑↑↑↑↑↑ ABOVE WAS ".NE." BEFORE 4/30/76. WHY?#@&Xαε
36000		IF(UPDN.NE.0)GO TO 577
36100		NN=-1
36200		IF(UMAX+DMAX.LT.14)NN=-NN
36300	C  SETS AUTO. BEAMS' STEM DIRECTION.
36400	577	X=10
36500		IF(NN)X=20
36600		IF(MB)RA=2
36700	C  2 BEAMS ON GRACE NOTES ALWAYS
36800		X=X+RA
36900	C  # OF BEAMS.  IT'S PUT IN  DOWN BELOW 550.
37000	200	M=KN
37100	207	L=M+1
37200		IF(R(1,L).NE.1)GO TO 307
37300		IF(R(5,L).GE.10)GO TO 307
37400		M=M+1
37500		GO TO 207
37600	C  FOR HEIGHTS OF DBL STPS, ETC.
37700	307	CONTINUE
37800	CX607	A=XNOTE(M)
37900	607	A=ZNOTE(M)
38000	C   A=NOTE 1.
38100		UMAX=A
38200		DMAX=A
38300	C  UP MAX. NOTE #, DOWN MAX. NOTE #.
38400	407	M=K+1
38500		IF(R(1,M).NE.1)GO TO 103
38600	CC	IF(R(9,M).NE.0)GO TO 103
38700		IF(R(5,M).GE.10)GO TO 103
38800	C  FINDS DBL+ STP ON LAST OF BEAM
38900		IF(R(6,M))GO TO 103
39000	C JUMP OUT IF A WHITE NOTE
39100		K=M
39200		GO TO 407
39300	103	IF(JSTEM.GT.KN)GO TO 604
39400	C FLAG IS SET (NR) IF STEMS ARE SPECIFIED IN DIFF. DIRECTIONS. (GRACE NTS??)
39500	604	NR=0
39600	
39700	603	DO 3 M=KN,K
39800		IF(R(1,M).NE.1)GO TO 3
39900	CXCXCX	IF(STEM.NE.0.AND.R(10,M).NE.0)GO TO 3
40000	C SKIP NOTES ON OTHER STAFF
40100		IF(M.EQ.K)GO TO 107
40200		IF(R(1,M+1).NE.1)GO TO 107
40300	C IT ONLY CARES ABOUT NOTES!
40400		IF(R(5,M+1).LT.10)GO TO 3
40500	C IGNORE LOWER (OR UPPER) NOTES OF CHORDS (NO STEM)-IN RE. UP-DOWN FEATURE.
40600	107	IF(MB)GO TO 7
40700	C  SKIP IF DEALING WITH GRACE NOTE BEAMS. (MB=-1)
40800		IF(ABS(R(4,M)).GE.100)GO TO 3
40900	C  SKIPS NON-NOTES
41000	CX7	B=XNOTE(M)
41100	7	B=ZNOTE(M)
41200	CX677	IF(JSTEM.LE.M.AND.R(10,M).NE.0)GO TO 55
41300	CYY677	IF(JSTEM.LE.M)GO TO 55
41400	677	IF(JSTEM.LE.KN)GO TO 55
41500	C  IGNORE STEM DIR. IF ALREADY SPECIFIED WITHIN THIS GROUP
41600		AA=R(5,M)
41700		IF(AA.LT.10.)GO TO 3
41800		STMDR=AA
41900		IF(NN.GT.0)GO TO 5
42000	C  JUMP IF STEM UP
42100		IF(STMDR.GE.20.)GO TO 55
42200		IF(STMDR.LT.10.)GO TO 55
42300		R(5,M)=STMDR+10.
42400		GO TO  551
42500	5	IF(STMDR.LT.20.)GO TO 55
42600		R(5,M)=STMDR-10.
42700	C************************
42800	C    STEM UP
42900	551	INVT=0
43000	55	IF(B.LT.UMAX)GO TO 13
43100	CC55	IF(B.LE.UMAX)GO TO 13
43200	C ↑↑↑↑↑↑↑↑ WAS .LT. !!!!! 5/76
43300		UMAX=B
43400		IF(JMAX)GO TO 3
43500		IF(M.EQ.KN)GO TO 3
43600		IF(M.EQ.K)GO TO 3
43700		UMAX=UMAX+1
43800		GO TO 3
43900	13	IF(B.GT.DMAX)GO TO 3
44000		DMAX=B
44100		IF(JMAX)GO TO 3
44200		IF(M.EQ.KN)GO TO 3
44300		IF(M.NE.K)DMAX=DMAX-1
44400	3	CONTINUE
44500	C  LOOKS FOR LOWER AND HIGHER NOTES THAN NOTE 1.
44600	C*************************************
44700	
44800	4	K=IT
44900	C  FOR EXTRA BEAMS WITH CHORDS. K WAS SAVED IN "IT"
45000		AA=A
45100		BB=B
45200		C=1
45300		IF(X.LT.20.)GO TO 48
45400	C  JUMP IF STEM IS UP
45500		CALL EXCH(AA,BB)
45600		C=-C
45700		CALL EXCH(UMAX,DMAX)
45800	48	IF(AA.LT.BB)GO TO 45
45900		IF(UMAX.EQ.A)GO TO 46
46000	47	A=UMAX-C
46100		B=A
46200		GO TO 444
46300	46	IF(UMAX.GT.AA)GO TO 47
46400		GO TO 49
46500	45	IF(UMAX.NE.B)GO TO 47
46600	49	A=AA
46700		B=BB
46800		IF(X.GE.20)CALL EXCH(A,B)
46900	
47000	444	RN(2+IS)=STAFF 
47100	446	DIS=(RN(IS+6)-RN(IS+3))/6.
47200	C  FOR TILT LATER -- 
47300		IF(ABS(A-B).LT.DIS)GO TO 143
47400		C=C*DIS
47500	C  NEW TILT ROUTINE.  CONSIDERS DISTANCE:HEIGHT
47600	C  LIMITS SLOPE OF BEAM
47700		IF(X.GE.20)GO TO 141
47800		IF(B.GT.A)GO TO 140
47900	142	B=A-C
48000		GO TO 143
48100	141	IF(B.GT.A)GO TO 142
48200	140	A=B-C
48300	
48400	CC143	BB=A
48500	CC143	IF(STMDR.GE.20)GO TO 530
48600	143	IF(X.GE.20)GO TO 530
48700	CC	IF(B.LT.A)BB=B
48800	C BB IS LOWEST SIDE OF BEAM
48900	CC	IF(BB.GE.0)GO TO 14
49000	C BEAM WILL ALWAYS TOUCH MIDDLE LINE OF STAFF
49100	CC	BB=-BB
49200		IF(A.LT.0)A=0
49300		IF(B.LT.0)B=0
49400		GO TO 14
49500	530	IF(A.GT.14)A=14
49600		IF(B.GT.14)B=14
49700	C  GETS NEW HEIGHT NUMBERS.
49800	
49900	14	IF(MB.EQ.0)GO TO 330
50000	C NEXT FOR GRACE NOTE BEAMS (MB=-1)
50100		C=100
50200		IF(A)C=-C
50300		A=A+C
50400	330	C=AMOD(X,10.0)-2
50500		IF(C.LE.0)GO TO 331
50600	C NEXT PUSHES OUT BEAMS IF 3 OR MORE.
50700		C=C+1
50800		IF(NN)C=-C
50900		A=A+C
51000		B=B+C
51100	331	RN(4+IS)=A
51200		RN(5+IS)=B
51300	C   MAKES HORIZONTAL BEAMS IF PATTERN IS UP-DOWN.
51400	C*******??????	RN(6+IS)=R(3,K)
51500	C  ABOVE IS POS.2
51600	C NEXT TO FIND TREMOLOS WHICH SHOULD BE PARALLEL TO BEAM.
51700		JA=IX
51800		AA=RN(IS+3)
51900		BB=RN(IS+6)
52000	300	IF(JA.GE.LS)GO TO 510
52100	C LS IS PTR TO RN ARRAY BEFORE BEAMS WERE ADDED.
52200		IF(RN(JA+1).EQ.6)GO TO 1300
52300	2300	JA=RN(JA)+JA+3
52400	C PUSH PTR AHEAD
52500		GO TO 300
52600	1300	C=RN(JA+3)
52700		IF(C.LT.AA.OR.C.GT.BB)GOTO 2300
52800	C NOW WE'VE FOUND TREM. WITHIN RANGE OF CURRENT BEAM.
52900		RN(JA+9)=C
53000		RN(JA+3)=AA
53100		RN(JA+6)=BB
53200		RN(JA+4)=A
53300		RN(JA+5)=B
53400		C=RN(JA+7)    
53500		IF(C.GT.-20.)GO TO 3300
53600		IF(X.LT.20.)C=C+10
53700		GO TO 4300
53800	3300	IF(X.GE.20)C=C-10
53900	4300	RN(JA+7)=C
54000	C X=P7 INFO FOR CURRENT BEAM. (STEM DIR., NUM. OF BEAMS.)
54100		RN(JA+10)=ABS(AMOD(X,10.0))
54200		GO TO 2300
54300	
54400	C ***********KN = 1ST NOTE, K=LAST NOTE.********
54500	510	M=R(5,KN)/10.0
54600		RN(7+IS)=M*10+AMOD(X,10.0)
54700		RN(10+IS)=0
54800		RN(IS+11)=-1
54900		CALL UPDATE(9)
55000		JA=IS
55100	C************************************** BMX ***********
55200		IF(JB)CALL BMX(RA)
55300		IF(JA.NE.IS)GO TO 514
55400		IF(JDIF.EQ.0)GO TO 514
55500	C FOR NEW COMPOSITE BEAM FEATURE 4/78
55600		IF(RA.EQ.1)GO TO 514
55700		RN(7+KDIF)=X-1
55800		RN(10+KDIF)=100
55900		DO 515 K=JDIF-1,1,-1
56000	C LOOK FOR INTERVENING GRACE NOTES OR RESTS.
56100		N=K
56200		IF(R(1,K).NE.1)GO TO 515
56300		IF(R(8,K).EQ.1000.)GO TO 515
56400		N=K
56500		GO TO 516
56600	515	CONTINUE
56700	516	RN(8+KDIF)=R(3,N)
56800		RN(9+KDIF)=R(3,JDIF)
56900		A=R(3,N)
57000		B=R(3,JDIF)
57100		IF(A.EQ.RN(3+KDIF))A=A+2.4
57200		IF(B.EQ.RN(6+KDIF))B=B-2.4
57300	CREATES PARTIAL BEAM IF NECESSARY.  (I.E. THERE'S A REST INVOLVED.)
57400		RN(8+KDIF)=A
57500		RN(9+KDIF)=B
57600	
57700	514	J=J+1
57800		A=VX(J)
57900		N=A
58000	C  SO ITEMS NEED NOT BE IN RIGHT ORDER.
58100		IF(MOD(N,100).GT.IRHY)A=0
58200		IF(A.NE.0)GO TO 505
58300		IF(J.LT.50)GO TO 514
58400	C  SOMETIMES A SLASH IS SEEN AS A 0 (WHEN PRECEDED BY SPACE).
58500	614	IF(INP(72).NE.ISTAR)GO TO  552
58600	
58700	714	IF(INVT)RETURN
58800		INVT=IS
58900	 	CALL NEWR
59000		IS=INVT
59100		RETURN
59200	552	CALL BMREAD
59300	C  TO READ MORE THAN 2 LINES.
59400		GO TO 25
59500		END
59600	 
59700		SUBROUTINE BMREAD
59800		COMMON /FRMT/F78F(1),FA1(1),FA5(1),IREAD /ALF/INP(72),ML
59900		1 /IDEV/IDEV
60000	552	IF(IREAD.NE.0)GO TO 3501
60100		CALL TYPE
60200		IF(IDEV.EQ.5)WRITE(21,4501)INP
60300		GO TO 1    
60400	3501	IF(IREAD.EQ.-1)READ(22,2501)J,INP
60500		IF(IREAD.EQ.-2)READ(22,4501)INP
60600	C  FOR 2ND LINE.
60700		CALL TYPOUT
60800	1	CALL LNEND
60810		CALL LULOOP
60855	C CHANGE LOWER CASE TO UPPER.
60900	4501	FORMAT(72A1)
61000	2501	FORMAT(I,72A1)
61100		END
61200